DIMENSION I(4),II(4),JIN(3,1000)
	COMMON/D/ JD(4000),ID(3,4000)  /JJJJ/JP,KP,XS,YS
	COMMON NMOUT
	INTEGER X1,X2,Y1,Y2
	EQUIVALENCE (X1,I(2)),(Y1,I(3)),(X2,II(2)),(Y2,II(3)),(J,I(4))
	1,(JJ,II(4))
1	FORMAT(' TYPE INPUT NAME  '$)
2	FORMAT(' TYPE OUTPUT NAME  '$)
3	FORMAT(A5)
4	FORMAT(' TYPE FUNC NAME  '$)
6	FORMAT(4I)
81	FORMAT(2I,2F)
66	FORMAT(5X,4I)
80	FORMAT(' X POS, Y POS, X SIZE, Y SIZE '$)
	TYPE 1
	ACCEPT 3,NMIN
C	TYPE 2
C	ACCEPT 3,NMOUT
	CALL IFILE(21,NMIN)
82	READ(21,6,END=95)NNN,(JIN(K,NNN),K=1,3)
	GO TO 82
C	CALL OFILE(22,NMOUT)
95	NN=0
	NX=0
	TYPE 80
	ACCEPT 81,JP,KP,XS,YS
	IF(XS.EQ.0)XS=1
	IF(YS.EQ.0)YS=1
5	CALL SHFT(I,JIN,NX)
C5	READ(21,6)I
C	X1=X1*XS+.5
C	Y1=Y1*YS+.5
C	TYPE 66,I
7	CALL SHFT(II,JIN,NX)
	IF(NX.GT.NNN)GO TO 100
C7	READ(21,6,END=100)II
C	X2=X2*XS+.5
C	Y2=Y2*YS+.5
C	TYPE 66,II
99	IF(JJ.EQ.0)GO TO 13
98	CALL NNO(NN)
	I(1)=NN
	ID(1,NN)=X1
	ID(2,NN)=Y1
	ID(3,NN)=J
C	WRITE(22,6)I
C	TYPE 6,I
	GO TO 8
13	M=1
	K=X2-X1 
	KK=K
	IF(K.GE.0)GO TO 10
	M=-1
	KK=-K
10	L=Y2-Y1 
	MM=1
	LL=L
	IF(L.GE.0)GO TO 11
	MM=-1
	LL=-L
11	IF(LL.GT.KK)GO TO 12
	IF(KK.LT.2)GO TO 98
	DO 9 N=X1,X2-M,M
	A=N-X1
	B=K
	NY=Y1+L*A/B+.5
	CALL NNO(NN)
C	TYPE 6,NN,N,NY,J
	ID(1,NN)=N
	ID(2,NN)=NY
	ID(3,NN)=J
C	WRITE(22,6)NN,N,NY,J
9	J=0
8	X1=X2
	Y1=Y2
	J=JJ
	GO TO 7
12	IF(LL.LT.2)GO TO 98
	DO 19 N=Y1,Y2-MM,MM
	A=N-Y1
	B=L
	NY=X1+K*A/B+.5
	CALL NNO(NN)
C	TYPE 6,NN,NY,N,J
C	WRITE(22,6)NN,NY,N,J
	ID(1,NN)=NY
	ID(2,NN)=N
	ID(3,NN)=J
19	J=0
	GO TO 8
C100	WRITE(22,6)II
100	CALL NNO(NN)
	DO 96 K=1,3
96	ID(K,NN)=II(K+1)
	ID(3,NN+1)=-1
C	END FILE 22
	CALL DPY  
	GO TO 95
	END

COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		SUBROUTINE DPY
C00004 ENDMK
C⊗;
	SUBROUTINE DPY
	COMMON/D/ JD(4000),I(3,4000)
	COMMON NAME
2	FORMAT(4I)
4	FORMAT(' X POS, Y POS, X SIZE, Y SIZE  '$)
5	FORMAT(4I)
	JJ=0
	KK=0
	MM=1
	NN=1
C6 	CALL IFILE(22,NAME)
6	N=0
	CALL DPYSET(1,JD,4000)
	CALL DPYCLR
C1	READ(22,2,END=99)N,(I(K,N),K=1,3)
1	N=N+1
	IF(I(3,N))GO TO 99
C -1 IN 3RD SLOT=END
	NX=MM*(JJ+I(1,N))
	NY=NN*(KK+I(2,N))
	IF(I(3,N).NE.0)GO TO 3
7	CALL AVECT(NX,NY)
	GO TO 1
3	CALL AIVECT(NX,NY)
	GO TO 1
99	CALL DPYOUT(1)
C	TYPE 4
C	ACCEPT 2,JJ,KK,MM,NN
C	IF(MM.EQ.0)MM=1
C	IF(NN.EQ.0)NN=1
C	GO TO 6
	END

	SUBROUTINE NNO(NN)
	IF(NN.LT.3999)GO TO 2 
	TYPE 1
1	FORMAT(' TOO MANY POINTS')
	RETURN
2	NN=NN+1
	END

 	SUBROUTINE SHFT(II,JIN,NX)
	COMMON  /JJJJ/JP,KP,XS,YS
	DIMENSION II(4),JIN(3,1000)
	NX=NX+1
	II(1)=NX
	II(2)=JP+(JIN(1,NX)*XS+.5)
	II(3)=KP+(JIN(2,NX)*YS+.5)
	II(4)=JIN(3,NX)
	END